home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / Oberon⁄F™ 1.2 / Preinstalled version / Obx / Mod / Lines / Lines (.txt)
Encoding:
Oberon Document  |  1996-07-08  |  7.2 KB  |  232 lines  |  [oODC/obnF]
  1. Documents.StdDocumentDesc
  2. Documents.DocumentDesc
  3. Containers.ViewDesc
  4. Views.ViewDesc
  5. Stores.StoreDesc
  6. Documents.ModelDesc
  7. Containers.ModelDesc
  8. Models.ModelDesc
  9. Stores.ElemDesc
  10. TextViews.StdViewDesc
  11. TextViews.ViewDesc
  12. TextModels.StdModelDesc
  13. TextModels.ModelDesc
  14. TextModels.AttributesDesc
  15. Helvetica
  16. Helvetica
  17. Helvetica
  18. MODULE ObxLines;
  19.     IMPORT Domains, Stores, Ports, Models, Views, Controllers, Properties;
  20.     CONST minVersion = 0; maxVersion = 0;
  21.     TYPE
  22.         Line = POINTER TO RECORD
  23.             next: Line;
  24.             x0, y0, x1, y1: LONGINT
  25.         END;
  26.         Model = POINTER TO RECORD (Models.ModelDesc)
  27.             lines: Line
  28.         END;
  29.         View = POINTER TO RECORD (Views.ViewDesc)
  30.             color: Ports.Color;
  31.             graph: Model
  32.         END;
  33.         UpdateMsg = RECORD (Models.UpdateMsg)
  34.             l, t, r, b: LONGINT
  35.         END;
  36.         LineOp = POINTER TO RECORD (Domains.OperationDesc)
  37.             graph: Model;
  38.             line: Line
  39.         END;
  40.         ColorOp = POINTER TO RECORD (Domains.OperationDesc)
  41.             view: View;
  42.             color: Ports.Color
  43.         END;
  44.     PROCEDURE GetBox (x0, y0, x1, y1: LONGINT; VAR l, t, r, b: LONGINT);
  45.     BEGIN
  46.         IF x0 > x1 THEN l := x1; r := x0 ELSE l := x0; r := x1 END;
  47.         IF y0 > y1 THEN t := y1; b := y0 ELSE t := y0; b := y1 END;
  48.         INC(r, Ports.point); INC(b, Ports.point)
  49.     END GetBox;
  50.     PROCEDURE (op: LineOp) Do;
  51.         VAR l: Line; msg: UpdateMsg;
  52.     BEGIN
  53.         l := op.line;
  54.         IF l # op.graph.lines THEN    (* insert op.line *)
  55.             ASSERT(l # NIL, 100); ASSERT(l.next = op.graph.lines, 101);
  56.             op.graph.lines := l
  57.         ELSE    (* delete op.line *)
  58.             ASSERT(l = op.graph.lines, 102);
  59.             op.graph.lines := l.next
  60.         END;
  61.         GetBox(l.x0, l.y0, l.x1, l.y1, msg.l, msg.t, msg.r, msg.b); Models.Broadcast(op.graph, msg)
  62.     END Do;
  63.     PROCEDURE (m: Model) Internalize (VAR rd: Stores.Reader);
  64.         VAR thisVersion: SHORTINT; x0: LONGINT; p: Line;
  65.     BEGIN
  66.         m.Internalize^(rd);
  67.         IF ~rd.cancelled THEN
  68.             rd.ReadVersion(minVersion, maxVersion, thisVersion);
  69.             IF ~rd.cancelled THEN
  70.                 rd.ReadLInt(x0); m.lines := NIL;
  71.                 WHILE x0 # MIN(LONGINT) DO
  72.                     NEW(p); p.next := m.lines; m.lines := p;
  73.                     p.x0 := x0; rd.ReadLInt(p.y0); rd.ReadLInt(p.x1); rd.ReadLInt(p.y1);
  74.                     rd.ReadLInt(x0)
  75.                 END
  76.             END
  77.         END
  78.     END Internalize;
  79.     PROCEDURE (m: Model) Externalize (VAR wr: Stores.Writer);
  80.         VAR p: Line;
  81.     BEGIN
  82.         m.Externalize^(wr);
  83.         wr.WriteVersion(maxVersion);
  84.         p := m.lines;
  85.         WHILE p # NIL DO
  86.             wr.WriteLInt(p.x0); wr.WriteLInt(p.y0); wr.WriteLInt(p.x1); wr.WriteLInt(p.y1);
  87.             p := p.next
  88.         END;
  89.         wr.WriteLInt(MIN(LONGINT))
  90.     END Externalize;
  91.     PROCEDURE (m: Model) CopyAllFrom (source: Models.Model);
  92.     BEGIN
  93.         m.lines := source(Model).lines    (* lines are immutable and thus can be shared *)
  94.     END CopyAllFrom;
  95.     PROCEDURE (m: Model) InitFrom (source: Models.Model);    (* do nothing *)
  96.     END InitFrom;
  97.     PROCEDURE (m: Model) Insert (x0, y0, x1, y1: LONGINT);
  98.         VAR op: LineOp; p: Line;
  99.     BEGIN
  100.         NEW(op); op.graph := m;
  101.         NEW(p); p.next := m.lines; op.line := p;
  102.         p.x0 := x0; p.y0 := y0; p.x1 := x1; p.y1 := y1;
  103.         Models.Do(m, "Insert Line", op)
  104.     END Insert;
  105.     PROCEDURE (op: ColorOp) Do;
  106.         VAR color: Ports.Color;
  107.     BEGIN
  108.         color := op.view.color;    (* save old state *)
  109.         op.view.color := op.color;    (* set new state *)
  110.         Views.Update(op.view, Views.keepFrames);    (* restore everything *)
  111.         op.color := color    (* old state becomes new state for undo *)
  112.     END Do;
  113.     PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
  114.         VAR thisVersion: SHORTINT; s: Stores.Store;
  115.     BEGIN
  116.         v.Internalize^(rd);
  117.         IF ~rd.cancelled THEN
  118.             rd.ReadVersion(minVersion, maxVersion, thisVersion);
  119.             IF ~rd.cancelled THEN
  120.                 rd.ReadLInt(v.color);
  121.                 rd.ReadStore(s); ASSERT(s # NIL, 100);
  122.                 IF s IS Model THEN
  123.                     v.InitModel(s(Model))
  124.                 ELSE
  125.                     rd.TurnIntoAlien(Stores.alienComponent)
  126.                 END
  127.             END
  128.         END
  129.     END Internalize;
  130.     PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
  131.     BEGIN
  132.         v.Externalize^(wr);
  133.         wr.WriteVersion(maxVersion);
  134.         wr.WriteLInt(v.color);
  135.         wr.WriteStore(v.graph)
  136.     END Externalize;
  137.     PROCEDURE (v: View) CopyFrom (source: Views.View);
  138.     BEGIN
  139.         v.CopyFrom^(source);
  140.         WITH source: View DO
  141.             v.color := source.color
  142.         END
  143.     END CopyFrom;
  144.     PROCEDURE (v: View) InitModel (m: Models.Model);
  145.     BEGIN
  146.         v.graph := m(Model)
  147.     END InitModel;
  148.     PROCEDURE (v: View) ThisModel (): Models.Model;
  149.     BEGIN
  150.         RETURN v.graph
  151.     END ThisModel;
  152.     PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: LONGINT);
  153.         VAR p: Line;
  154.     BEGIN
  155.         p := v.graph.lines;
  156.         WHILE p # NIL DO
  157.             f.DrawLine(p.x0, p.y0, p.x1, p.y1, f.dot, v.color);
  158.             p := p.next
  159.         END
  160.     END Restore;
  161.     PROCEDURE (v: View) HandleModelMsg (VAR msg: Models.Message);
  162.     BEGIN
  163.         WITH msg: UpdateMsg DO
  164.             Views.UpdateIn(v, msg.l, msg.t, msg.r, msg.b, Views.keepFrames)
  165.         ELSE
  166.         END
  167.     END HandleModelMsg;
  168.     PROCEDURE (v: View) SetColor (color: Ports.Color);
  169.         VAR op: ColorOp;
  170.     BEGIN
  171.         NEW(op); op.view := v; op.color := color; Views.Do(v, "Set Color", op)
  172.     END SetColor;
  173.     PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message;
  174.                                                                 VAR focus: Views.View);
  175.         VAR x0, y0, x1, y1, x, y, res, l, t, r, b: LONGINT; modifiers: SET; isDown: BOOLEAN;
  176.     BEGIN
  177.         WITH msg: Controllers.PollOpsMsg DO
  178.             msg.valid := {Controllers.pasteChar}
  179.         | msg: Controllers.TrackMsg DO
  180.             x0 := msg.x; y0 := msg.y; x1 := x0; y1 := y0;
  181.             f.SaveRect(f.l, f.t, f.r, f.b, res);    (* operation was successful if res = 0 *)
  182.             IF res = 0 THEN f.DrawLine(x0, y0, x1, y1, Ports.point, v.color) END;
  183.             REPEAT
  184.                 f.Input(x, y, modifiers, isDown);
  185.                 IF (x # x1) OR (y # y1) THEN
  186.                     GetBox(x0, y0, x1, y1, l, t, r, b); f.RestoreRect(l, t, r, b, Ports.keepBuffer);
  187.                     x1 := x; y1 := y;
  188.                     IF res = 0 THEN f.DrawLine(x0, y0, x1, y1, Ports.point, v.color) END
  189.                 END
  190.             UNTIL ~isDown;
  191.             GetBox(x0, y0, x1, y1, l, t, r, b); f.RestoreRect(l, t, r, b, Ports.disposeBuffer);
  192.             v.graph.Insert(x0, y0, x1, y1)
  193.         | msg: Controllers.EditMsg DO
  194.             IF msg.op = Controllers.pasteChar THEN
  195.                 CASE msg.char OF
  196.                 | "B": v.SetColor(Ports.black)
  197.                 | "r": v.SetColor(Ports.red)
  198.                 | "g": v.SetColor(Ports.green)
  199.                 | "b": v.SetColor(Ports.blue)
  200.                 ELSE
  201.                 END
  202.             END
  203.         ELSE
  204.         END
  205.     END HandleCtrlMsg;
  206.     PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
  207.     BEGIN
  208.         WITH msg: Properties.FocusPref DO
  209.             msg.setFocus := TRUE
  210.         ELSE
  211.         END
  212.     END HandlePropMsg;
  213.     PROCEDURE Deposit*;
  214.         VAR m: Model; v: View;
  215.     BEGIN
  216.         NEW(m);
  217.         NEW(v); v.InitModel(m);
  218.         Views.Deposit(v)
  219.     END Deposit;
  220. END ObxLines.
  221. TextControllers.StdCtrlDesc
  222. TextControllers.ControllerDesc
  223. Containers.ControllerDesc
  224. Controllers.ControllerDesc
  225. TextRulers.StdRulerDesc
  226. TextRulers.RulerDesc
  227. TextRulers.StdStyleDesc
  228. TextRulers.StyleDesc
  229. TextRulers.AttributesDesc
  230. Helvetica
  231. Documents.ControllerDesc
  232.